home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1991 June / 1991-06.d64 / geoinfo editor (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  258 lines
  1. 0 clr
  2. 4 rem copyright 1991 - compute publications intl ltd - all rights reserved
  3. 5 rem by henning vahlenkamp
  4. 10 rem***set-up***
  5. 20 if peek(65534)=23 and peek(215)=128 then40
  6. 30 poke53280,6:poke53281,6:xx=3:tx=4:goto60
  7. 40 poke53265,11:poke53296,1:sys52684,3,26
  8. 50 xx=23:xx$="":tx=24
  9. 60 dn=8:t=18:open1,dn,15
  10. 70 print#1,"m-r"chr$(198)chr$(229)chr$(1)
  11. 80 get#1,by$:if asc(by$)=255 then t=40:fl=1
  12. 90 close1:dim c$(16),t$(13),m$(15)
  13. 100 for l=1 to 32
  14. 110 hb$=hb$+chr$(192):s$=s$+" ":next
  15. 120 for l=. to 10:read ch$(l),ll(l):next
  16. 130 for l=. to 16:read c$(l):next
  17. 140 for l=. to 2:read q$(l):next
  18. 150 for l=1 to 15:read m$(l):next
  19. 160 h$="[221]":z$=chr$(.):ss$=chr$(160):hm$=""
  20. 170 rt$="":dn$="":rs$=""
  21. 180 for l=1 to xx:r$=r$+rt$:next
  22. 190 for l=1 to 21:dm$=dm$+dn$:next
  23. 200 for l=. to 5
  24. 210 rt$=rt$+rt$+xx$:dn$=dn$+dn$:next
  25. 220 dn$=hm$+dn$:hx$="0123456789abcdef"
  26. 230 rem***screen***
  27. 240 printchr$(14)"[147]"r$"[176]"hb$"[174]"
  28. 250 printr$h$"**"h$"   "m$(1)"   "h$"**"h$
  29. 260 printr$"[171]"hb$"[179]"
  30. 270 for l=1 to 10:printr$h$s$h$:next
  31. 280 printr$h$left$(s$,9)left$(hb$,23)"[179]"
  32. 290 for l=1 to 4
  33. 300 printr$h$"[155][204]"chr$(l+48)""h$left$(s$,29)h$:next
  34. 310 printr$"[173][192][192][177]"left$(hb$,29)"[189]"
  35. 320 printr$"[192]"hb$"[192]":print:printr$"[192]"hb$"[192]"
  36. 330 printr$"[155]"m$(2):printr$m$(3);
  37. 340 rem***main***
  38. 350 printhm$left$(dn$,5);
  39. 360 for l=. to 10
  40. 370 printleft$(rt$,tx)"[155]"ch$(l)"":next
  41. 380 gosub1550
  42. 390 printleft$(dn$,mc+5)left$(rt$,tx)"[155]"rs$left$(ch$(mc),len(ch$(mc))-1)""
  43. 400 get k$:if k$="" then400
  44. 410 if k$=chr$(13) then530
  45. 420 if k$="d" then740
  46. 430 if k$="c" then860
  47. 440 if k$="r" then920
  48. 450 if k$="w" then1630
  49. 460 if k$="p" then1970
  50. 470 if k$="q" then2370
  51. 480 if k$="" then mc=mc+1:if mc>10 then mc=.
  52. 490 if k$="[145]" then mc=mc-1:if mc<. then mc=10
  53. 500 printleft$(dn$,m2+5)left$(rt$,tx)"[155]"left$(ch$(m2),len(ch$(m2))-1)""
  54. 510 m2=mc:goto390
  55. 520 rem***change***
  56. 530 tm$=t$(mc):gosub2190
  57. 540 if t$(.)="" then printm$(8):gosub2210:gosub2200:goto400
  58. 550 if mc<>2 and mc<>4 and mc<>5 then ln=ll(mc):gosub2060
  59. 560 on mc+1 goto570,570,580,570,580,580,590,570,620,650,680
  60. 570 t$(mc)=tx$:goto710
  61. 580 printm$(9):gosub2210:gosub2200:goto400
  62. 590 mm=val(mid$(tx$,1,2)):dd=val(mid$(tx$,3,2)):yy=val(mid$(tx$,5,2))
  63. 600 hh=val(mid$(tx$,7,2)):nn=val(mid$(tx$,9,2))
  64. 610 fg=1:gosub1340:goto710
  65. 620 if tx$="y" then t$(8)="yes":wp=wp or 64
  66. 630 if tx$="n" then t$(8)="no":wp=wp and 191
  67. 640 goto710
  68. 650 ad$=tx$:t$(9)="":q=1:for l=. to 2
  69. 660 t$(9)=t$(9)+q$(l)+mid$(tx$,q,4)
  70. 670 q=q+4:next:goto710
  71. 680 x=val(tx$):if x<1 or x>4 then400
  72. 690 ln=29:if x=4 then ln=8
  73. 700 gosub2060:t$(9+x)=tx$:goto350
  74. 710 if tx$="" then t$(mc)=tm$:goto400
  75. 720 goto350
  76. 730 rem***directory***
  77. 740 print"[147]":x=11:y=12
  78. 750 open1,dn,.,"$0":get#1,v1$
  79. 760 get#1,v1$,v1$,v1$,v1$,v2$,v3$
  80. 770 printasc(v1$+z$)+asc(v2$+z$)*256v3$;
  81. 780 for l=. to x
  82. 790 get#1,v1$,v2$:printv1$v2$;:next
  83. 800 get k$:if k$="q" then830
  84. 810 if k$<>"" then gosub2210
  85. 820 print:if v2$<>"" then x=y:goto760
  86. 830 close1
  87. 840 print:print m$(10):gosub2210:goto240
  88. 850 rem***disk command***
  89. 860 ln=33:gosub2060:if tx$="" then900
  90. 870 open1,dn,15:print#1,tx$
  91. 880 input#1,en,em$,et,es:gosub2190
  92. 890 printen;em$;et;es:gosub2210
  93. 900 close1:gosub2200:goto400
  94. 910 rem***read & decode***
  95. 920 fi$="":ln=16:s=1:if fl then s=3
  96. 930 gosub2060:if tx$="" then400
  97. 940 gosub2190:printm$(6)
  98. 950 open1,dn,15,"i0":open2,dn,2,"#"
  99. 960 print#1,"u1";2;.;t;s
  100. 970 get#2,tr$,se$:tr$=tr$+z$:se$=se$+z$
  101. 980 for vl=5 to 244 step 32
  102. 990 print#1,"b-p";2;vl
  103. 1000 for i=1 to 16:get#2,by$
  104. 1010 if by$=ss$ then1030
  105. 1020 fi$=fi$+by$:next i
  106. 1030 if fi$=tx$ then1080
  107. 1040 fi$="":next vl
  108. 1050 if asc(tr$)<>. then s=asc(se$):goto960
  109. 1060 gosub2200:gosub2190:printm$(5)
  110. 1070 gosub2210:goto1530
  111. 1080 zz$=s1$:s1$="":print#1,"b-p";2;vl-3
  112. 1090 for l=1 to 30
  113. 1100 get#2,by$:if by$="" then by$=z$
  114. 1110 if l=20 and by$=z$ then s1$=zz$:gosub2190:printm$(15):gosub2210:goto1530
  115. 1120 s1$=s1$+by$:next
  116. 1130 s2$="":ad$="":ss=s
  117. 1140 for l=. to 13:t$(l)="":next
  118. 1150 kk=144:if fl then kk=4
  119. 1160 print#1,"u1";2;.;t;.:print#1,"b-p";2;kk
  120. 1170 for l=1 to 16
  121. 1180 get#2,by$:if by$=ss$ then1200
  122. 1190 t$(1)=t$(1)+by$:next
  123. 1200 tk=asc(mid$(s1$,20,1)):sk=asc(mid$(s1$,21,1))
  124. 1210 print#1,"u1";2;.;tk;sk
  125. 1220 print#1,"b-p";2;68
  126. 1230 for l=1 to 187:get#2,by$:if by$="" then by$=z$
  127. 1240 s2$=s2$+by$:next:close2:close1
  128. 1250 t$(.)=tx$:t$(2)=c$(asc(mid$(s1$,23,1)))
  129. 1260 for l=10 to 27
  130. 1270 by$=mid$(s2$,l,1):if by$=z$ then1290
  131. 1280 t$(3)=t$(3)+by$:next
  132. 1290 t$(4)=c$(asc(mid$(s1$,22,1))+15)
  133. 1300 x=asc(mid$(s1$,29,1))+asc(mid$(s1$,30,1))*256
  134. 1310 t$(5)=str$(int(x/4))+"k  "+str$(x)+" blocks"
  135. 1320 mm=asc(mid$(s1$,25,1)):dd=asc(mid$(s1$,26,1)):yy=asc(mid$(s1$,24,1))
  136. 1330 hh=asc(mid$(s1$,27,1)):nn=asc(mid$(s1$,28,1))
  137. 1340 t$(6)=str$(mm)+"/"+str$(dd)+"/"+str$(yy)
  138. 1350 x$=str$(nn):if len(x$)=2 then x$=" 0"+right$(x$,1)
  139. 1360 t$(6)=t$(6)+" "+str$(hh)+":"+x$
  140. 1370 if fg then fg=.:return
  141. 1380 for l=30 to 47
  142. 1390 by$=mid$(s2$,l,1):if by$=z$ then1410
  143. 1400 t$(7)=t$(7)+by$:next
  144. 1410 wp=asc(left$(s1$,1))
  145. 1420 if wp>133 then t$(8)="yes":goto1440
  146. 1430 t$(8)="no"
  147. 1440 q=2:for l=2 to 6 step 2
  148. 1450 x=asc(mid$(s2$,l+2,1))+asc(mid$(s2$,l+3,1))*256
  149. 1460 gosub2240:ad$=ad$+a$:t$(9)=t$(9)+q$(l-q)+a$
  150. 1470 q=q+1:next
  151. 1480 x=93:for i=10 to 13
  152. 1490 for l=x to x+28
  153. 1500 by$=mid$(s2$,l,1):if by$=z$ then1530
  154. 1510 t$(i)=t$(i)+by$
  155. 1520 next l:x=x+29:next i
  156. 1530 close2:close1:gosub2200:goto380
  157. 1540 rem***update screen***
  158. 1550 printhm$""
  159. 1560 for l=. to 9
  160. 1570 printtab(tx+10)t$(l)left$(s$,21-len(t$(l)))
  161. 1580 next:print
  162. 1590 for l=10 to 13
  163. 1600 printtab(tx+3)t$(l)left$(s$,29-len(t$(l)))
  164. 1610 next:return
  165. 1620 rem***encode & write***
  166. 1630 gosub2190:if t$(.)="" then printm$(12):gosub2210:gosub2200:goto400
  167. 1640 printm$(13):gosub2210
  168. 1650 if k$<>"y" then1950
  169. 1660 gosub2190:print m$(7):for l=. to 5:tt$(l)="":next
  170. 1670 for i=. to 1
  171. 1680 x=len(t$(i)):tt$(i)=t$(i)
  172. 1690 if x<16 then for j=1 to 16-x:tt$(i)=tt$(i)+ss$:next j
  173. 1700 next i
  174. 1710 l=2:for i=3 to 7 step 4
  175. 1720 x=len(t$(i)):tt$(l)=t$(i)
  176. 1730 if x<18 then for j=1 to 18-x:tt$(l)=tt$(l)+z$:next j
  177. 1740 l=3:next i
  178. 1750 dt$=chr$(yy)+chr$(mm)+chr$(dd)+chr$(hh)+chr$(nn)
  179. 1760 for l=1 to 9 step 4
  180. 1770 x$=mid$(ad$,l,4):gosub2290
  181. 1780 hi=int(x/256):lo=x-hi*256
  182. 1790 tt$(4)=tt$(4)+chr$(lo)+chr$(hi):next
  183. 1800 for l=10 to 13:tt$(5)=tt$(5)+t$(l):next
  184. 1810 x=len(tt$(5))
  185. 1820 if x<95 then for l=1 to 95-x:tt$(5)=tt$(5)+z$:next
  186. 1830 s1$=chr$(wp)+mid$(s1$,2,2)+tt$(.)+mid$(s1$,20,4)+dt$+mid$(s1$,29,2)
  187. 1840 tm$=chr$(wp)+mid$(s2$,2,2)+tt$(4)+tt$(2)+mid$(s1$,28,2)
  188. 1850 s2$=tm$+tt$(3)+mid$(s2$,48,45)+tt$(5)
  189. 1860 open1,dn,15,"i0":open2,dn,2,"#"
  190. 1870 print#1,"u1";2;.;t;ss:print#1,"b-p";2;vl-3
  191. 1880 print#2,s1$;:print#1,"u2";2;.;t;ss
  192. 1890 close2:close1:open1,dn,15,"i0":open2,dn,2,"#"
  193. 1900 print#1,"u1";2;.;t;.:print#1,"b-p";2;kk
  194. 1910 print#2,tt$(1);:print#1,"u2";2;.;t;.
  195. 1920 close2:close1:open1,dn,15,"i0":open2,dn,2,"#"
  196. 1930 print#1,"u1";2;.;tk;sk:print#1,"b-p";2;68
  197. 1940 print#2,s2$;:print#1,"u2";2;.;tk;sk
  198. 1950 close2:close1:gosub2200:goto400
  199. 1960 rem***printer dump***
  200. 1970 gosub2190
  201. 1980 if t$(.)="" then printm$(11):gosub2210:goto2040
  202. 1990 open4,4,7:close4:if st<>0 then printm$(14):gosub2210:goto2040
  203. 2000 printm$(4):open4,4,7
  204. 2010 for l=. to 9:print#4,ch$(l)t$(l):next
  205. 2020 print#4:for l=10 to 13
  206. 2030 print#4,"[204]"chr$(l+39)":"t$(l):next:close4
  207. 2040 gosub2200:goto400
  208. 2050 rem***command line***
  209. 2060 tx$="":gosub2190
  210. 2070 get k$:v=asc(k$+z$)
  211. 2080 if (v>31 and v<96) or (v>192 and v<219) or v=20 then2110
  212. 2090 if v=13 then2170
  213. 2100 goto2070
  214. 2110 if tx$="" and v=20 then2070
  215. 2120 if len(tx$)>=ln and v<>20 then2070
  216. 2130 printk$;
  217. 2140 if v>192 then k$=chr$(v-96)
  218. 2150 if v<>20 then tx$=tx$+k$:goto2070
  219. 2160 tx$=left$(tx$,len(tx$)-1):goto2070
  220. 2170 gosub2200:return
  221. 2180 rem***set, clear, wait***
  222. 2190 printhm$dm$r$":";:return
  223. 2200 printhm$dm$r$s$"    "hm$:return
  224. 2210 get k$:if k$="" then2210
  225. 2220 return
  226. 2230 rem***dec-hex, hex-dec***
  227. 2240 a$="":z=1:for i=1 to 3
  228. 2250 v=int(x/(4096/z)):a$=a$+mid$(hx$,v+1,1)
  229. 2260 x=int(x-v*(4096/z))
  230. 2270 z=z*16:next
  231. 2280 a$=a$+mid$(hx$,x+1,1):return
  232. 2290 a$="":x=.:for i=1 to 4
  233. 2300 a$=mid$(x$,5-i,1)
  234. 2310 for j=1 to 16
  235. 2320 if a$=mid$(hx$,j,1) then2340
  236. 2330 next j
  237. 2340 x=x+(16^(i-1))*(j-1):next i:if x>65535 then x=.
  238. 2350 return
  239.